Shareware Grab Bag/Shareware Grab Bag.iso/003/litlbk24.arc/LITLBOOK.PAS

Pascal/Delphi Source File | 1987-05-29 | 49.2 KB | 1,530 lines

{$C-}

PROGRAM LitlBook;   { Copyright (C)1986,87 by Jamestown Software }
                    { Written by Kenn Flee, Jamestown Software   }
                    { 2508 Valley Forge, Madison WI 53719        }
                    { NonCommercial Use Only           5/18/86   }

                    { Requires Turbo Database Toolbox to compile }

CONST
  MaxDataRecSize = 300;
  MaxKeyLen      =  15;
  PageSize       =  24;
  Order          =  12;
  PageStackSize  =   8;
  MaxHeight      =   5;

  ClassFileName = 'LITLCLAS.DAT';
  DataFileName  = 'LITLBOK2.DAT';
  IndexFileName = 'LITLBOK2.IXN';

{.L-}
{$I ACCESS.BOX}
{$I GETKEY.BOX}
{$I ADDKEY.BOX}
{$I DELKEY.BOX}
{$I SORT.BOX}
{.L+}

TYPE
  Str8    = String[8];
  Str35   = String[35];
  Str80   = String[80];
  Str255  = String[255];
  AnyStr  = String[255];
  CharSet = Set of Char;
  RegPack = record case Integer of
              1: (AX,BX,CX,DX,BP,SI,DS,ES,Flags : integer);
              2: (AL,AH,BL,BH,CL,CH,DL,DH       : Byte   );
            end;
  DataRecord = Record
                 Status    : Integer;
                 FName     : String[15];
                 LName     : String[30];
                 Address   : String[25];
                 CityState : String[25];
                 Zip       : String[10];
                 Phone1    : String[12];
                 Phone2    : String[12];
                 Class     : String[2];
                 Comment   : String[79];
               End;


VAR
  Regs         : RegPack;
  Ch           : Char;
  DRec,DRec2   : DataRecord;
  DFile        : DataFile;
  IFile        : IndexFile;
  ClassList    : Array[1..30] of Str35;
  CFile        : File of Str35;
  OutFile      : Text;
  Key          : String[15];
  RecNum       : Integer;
  TDate        : Str8;
  EDrive       : Str80;
  MenuChoice,
  ReportChoice : Char;
  HiAt,LoAt    : Byte;
  Abort        : Boolean;
  ClassSort    : Boolean;
  ZipSort      : Boolean;
  Labels       : Boolean;
  HardCopy     : Boolean;
  LastNameFirst: Boolean;
  ParamRead    : Boolean;
  AsciiFile    : Boolean;
  AsciiName    : Str80;
  RunCount     : Integer;

{-----------------------------------------------------------------------
  Turbo Database Toolbox Summary:

  MakeFile(DataFileVar,FileName,RecordLength); *
   - Creates a new data file and prepares it for processing.
  OpenFile(DataFileVar,FileName,RecordLength); *
   - Opens an existing data file and prepares it for processing.
  CloseFile(DataFileVar);
   - Closes a data file.
  AddRec(DataFileVar,RecordNumber,Buffer);
   - Adds a new record to data file; returns RecordNumber.
  DeleteRec(DataFileVar,RecordNumber);
   - Deletes specified record.
  GetRec(DataFileVar,RecordNumber,Buffer);
   - Reads specified record into buffer.
  PutRec(DataFileVar,RecordNumber,Buffer);
   - Writes record to specified record number.
  FileLen(DataFileVar);
   - Returns number of records ASSIGNED to data file.
  UsedRecs(DataFileVar);
   - Returns number of records in use.

  InitIndex;
   - Call before using any index file routines, once only.
  MakeIndex(IndexFileVar,FileName,KeyLength,Status); *
   - Creates new index file; Status 0=No dup keys allowed, 1=dups allowed.
  OpenIndex(IndexFileVar,FileName,KeyLength,Status); *
   - Opens existing index file.
  CloseIndex(IndexFileVar);
   - Closes index file.
  AddKey(IndexFileVar,RecordNumber,Key); *
   - Adds a key using Record Number returned by AddRec.
  DeleteKey(IndexFileVar,RecordNumber,Key); *
   - Deletes key; Record number used if dup keys allowed.
  FindKey(IndexFileVar,RecordNumber,Key); *
   - Returns record number of a MATCHING key.
  SearchKey(IndexFileVar,RecordNumber,Key); *
   - Returns record number of first key EQUAL TO or GREATER THAN specified key.
  NextKey(IndexFileVar,RecordNumber,Key); *
   - Returns next record number after specified key, plus new key.
   - Must use FindKey, SearchKey or ClearKey before first use or after
     AddKey or DeleteKey;
  PrevKey(IndexFileVar,RecordNumber,Key); *
   - Returns preceeding record number to specified key, plus new key.
   - Must use FindKey, SearchKey or ClearKey before first use or after
     AddKey or DeleteKey;
  ClearKey
   - Sets index file pointer to beginning/end of index file.

  * OK - A boolean var. generally set to TRUE on success and FALSE on error.

-----------------------------------------------------------------------------}

(* SCREEN CODE -------------------------------------------------------*)

CONST  VideoEnable = $08;               { Video Signal Enable Bit }
       CurrentSaved : Boolean = False;
       On  = True;
       Off = False;

TYPE   Imagetype  = Array[1..4000] of char;  { Screen Image }

VAR    Screen      : Record
                       Image: Imagetype;
                       X1,Y1:   Integer;
                     End;
       Crtmode     : Byte      ABSOLUTE $0040:$0049;
       Monobuffer  : Imagetype ABSOLUTE $B000:$0000;
       Colorbuffer : Imagetype ABSOLUTE $B800:$0000;
       CrtAdapter  : Integer   ABSOLUTE $0040:$0063;
       VideoMode   : Byte      ABSOLUTE $0040:$0065;


PROCEDURE Video(Switch:Boolean); { Video On/Off to avoid Read/Write snow }
  Begin
    If (Switch=Off) then Port[CrtAdapter+4] := (VideoMode-VideoEnable)
      Else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  End;

PROCEDURE SaveScreen;
  Begin
    If NOT CurrentSaved then begin
      Video(Off);
      With Screen Do Begin
        X1:=WhereX;
        Y1:=WhereY;
        If CrtMode = 7 then Image := Monobuffer Else Image := Colorbuffer ;
      End;
      Video(On);
      CurrentSaved:=True;
    End;
  End; { procedure SaveScreen }

PROCEDURE RestoreScreen;
  Begin
    If CurrentSaved then begin
      Video(Off);
      With Screen Do Begin
        If CrtMode = 7 then Monobuffer := Image Else Colorbuffer := Image;
        GotoXY(X1,Y1);
      End;
      Video(On);
      CurrentSaved:=False;
    End;
  End; { procedure RestoreScreen; }

PROCEDURE FastWrite(col,row,attrib:byte;str:str80);  { by Marshall Brain }
  Begin                                       { col = 0..79, row = 0..24 }
    inline
      ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/
       $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/
       $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/
       $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/
       $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/
       $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/
       $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);
  End; { procedure FastWrite }

{------------------------------------------------------------------------}

FUNCTION DOSDate:Str8;
  VAR
    mstr,dstr:     string[2];
    ystr:          string[4];
  begin
    Regs.AX := $2A00;
    MsDos(Regs);
    with Regs do begin
      str(cx,ystr);                        {convert to string}
      str(dx mod 256,dstr);                     { " }
      str(dx shr 8,mstr);                       { " }
    end;
    Ystr:=Copy(Ystr,3,2);
    If Length(Dstr) = 1 then Dstr:='0'+Dstr;
    DOSdate := mstr + '/' + dstr + '/' + ystr  ;
  end;

FUNCTION ConstStr(C:Char; N:Integer) : Str80;
  VAR S : String[80];
  Begin
    If N<0 then N:=0;
    S[0] := Chr(N);
    FillChar(S[1],N,C);
    ConstStr := S;
  End; { function ConstStr }

FUNCTION MonitorType : Integer;
  Begin
    MonitorType := Mem[$0040:$0049];
  End; { function MonitorType }

PROCEDURE HideCursor;
  Begin
    Inline($B9/$0F00/$B4/$01/$CD/$10);
  End; { procedure HideCursor }

PROCEDURE RestoreCursor;
  Begin
    If MonitorType = 7 then                  { Mono }
      Inline($B9/$0C0D/$B4/$01/$CD/$10)
    Else Inline($B9/$0607/$B4/$01/$CD/$10);  { CGA }
  End; { procedure RestoreCursor }

PROCEDURE Beep;
  Begin
    Sound(1440);Delay(60);
    NoSound;
  End; { procedure Beep }

PROCEDURE Boop;
  Begin
    Sound(330);Delay(120);
    NoSound;
  End; { procedure Boop }

FUNCTION Yes: Boolean;
  VAR Ch:Char;
  Begin
    Repeat
      Read(Kbd,Ch);
      Ch:=UpCase(Ch);
      If Not (Ch in ['Y','N']) then Boop;
    Until Ch in ['Y','N'];
    Yes := (Ch='Y');
  End; { function Yes }

FUNCTION PrReady: Boolean;
  VAR I : Integer;
  Begin
    Regs.ax:=$0200;
    Regs.dx:=$0000;
    Intr($17,Regs);
    I := ((regs.ax and $FF00) shr 8);
    If (I=144) then PrReady := True
      Else PrReady := False;
  End; { function PrReady }

PROCEDURE PrinterWarning;
  Begin
    SaveScreen;
    FastWrite(15,16,HiAt,'┌──────────────────────────────────────────────────┐');
    FastWrite(15,17,HiAt,'│      Printer does not appear to be ready...      │');
    FastWrite(15,18,HiAt,'│      Press any key when problem is fixed,        │');
    FastWrite(15,19,HiAt,'│            or <ESC> to return to Main Menu.      │');
    FastWrite(15,20,HiAt,'└──────────────────────────────────────────────────┘');
    Repeat
      Beep;
      Read(Kbd,Ch);
      If (Ch=#27) and (NOT Keypressed) then begin
        Abort:=True;
        RestoreScreen;
        Exit;
      End;
    Until PrReady;
    RestoreScreen;
  End; { procedure PrinterWarning }

PROCEDURE PrinterSet;
  Begin
    SaveScreen;
    FastWrite(15,16,HiAt,'┌──────────────────────────────────────────────────┐');
    FastWrite(15,17,HiAt,'│     Position printer at top of new page...       │');
    FastWrite(15,18,HiAt,'│     Press any key when ready or <ESC> to quit.   │');
    FastWrite(15,19,HiAt,'└──────────────────────────────────────────────────┘');
    Beep;
    Read(Kbd,Ch);
    If (Ch=#27) and (NOT Keypressed) then Abort:=True;
    RestoreScreen;
  End; { procedure PrinterSet }

PROCEDURE SetAt;
  Begin
    LoAt:=$07;
    If MonitorType = 7 then HiAt:=$0F else HiAt:=$0E;
  End; { procedure SetAt }

FUNCTION Freespace:real;
  VAR  fr : real;
  Begin
    With Regs do begin
      dx := 0;
      ah := $36;
      MsDos(Regs);
      fr := bx;
      if ax <> $FFFF then Freespace := fr * ax * cx else Freespace := 0
    End;
  End;  { function Freespace }

Function CenterStr(S:Str255; Size:Byte) : Str255;
  VAR I:Integer;
  Begin
    I:=Size-Length(s);
    I:=Trunc(I/2);
    CenterStr:=ConstStr(' ',I)+S+ConstStr(' ',size-Length(S)-I);
  End;

PROCEDURE DisplayID;
  Begin
    ClrScr;
    HideCursor;
    FastWrite(10,0,HiAt,'┌───────────────────────────────────────────────────────────┐');
    FastWrite(10,1,HiAt,'│                                                           │');
    FastWrite(10,2,HiAt,'│                                                           │');
    FastWrite(10,3,HiAt,'│                                                           │');
    FastWrite(10,4,HiAt,'│                                                           │');
    FastWrite(10,5,HiAt,'└───────────────────────────────────────────────────────────┘');
    FastWrite(12,1,HiAt,CenterStr('LITLBOOK -- A User-Supported Address Book Program  V2.4',58));
    FastWrite(12,2,HiAt,CenterStr('----------',58));
    FastWrite(12,3,LoAt,CenterStr('Written by Kenn Flee of Jamestown Software',58));
    FastWrite(12,4,LoAt,CenterStr('2508 Valley Forge Dr., Madison WI  53719  (C)1986,87',58));
    RunCount:=RunCount-1;
    If RunCount<1 then begin
      FastWrite(12,6,LoAt,CenterStr('Your support of $5-$10 would be appreciated.',58));
      RunCount:=8;
    End;
    RestoreCursor;
  End;

FUNCTION Exist(FileName : Str80) : Boolean;
  VAR
    Fil : file;
  Begin
    Assign(Fil,FileName);
    {$I-}
    Reset(Fil);
    {$I+}
    Exist := (IOResult=0);
    Close(Fil);
  End;

TYPE FieldType = (Af,Nf,Rf,Df,Yf);    { Alpha, Numeric, Real, Date, Yes/No }

PROCEDURE InputStr (VAR S : AnyStr;
                        L,X,Y : Integer;
                        FType : FieldType;
                        Term : CharSet;
                    VAR TC : Char);
  CONST
    UnderScore = '_';
  VAR
    P : Integer;
    Ch,Ch2 : Char;
    LegalChar : CharSet;
    FirstChar : Boolean;
    EntryString : AnyStr;
    X1,X2,X3 : Integer;
    Error : Boolean;
  Begin
    Case FType of
      Af : LegalChar := [' '..'~'];             { Alpha }
      Nf : LegalChar := ['-','0'..'9'];         { Numeric }
      Rf : LegalChar := ['-','.','0'..'9'];     { Real }
      Df : LegalChar := ['/','0'..'9'];         { Date }
      Yf : LegalChar := ['Y','y','N','n'];      { Yes/No }
    End; { case }
    GotoXY(X,Y); Write(S,ConstStr(UnderScore,L-Length(S)));
    P := 0;
    FirstChar := True;
    EntryString := S;
    Repeat
      GotoXY(X+P,Y);
      Read(Kbd,Ch);
      If ((Ch in [#32..#126]) and FirstChar) then begin
        P:=0;
        S:='';
        Write(S,ConstStr(UnderScore,L-Length(S)));
        GotoXY(X+P,Y);
      End;
      FirstChar := False;
      Case Ch of
        #32..#126 : If (P<L) and (Ch in LegalChar) then
                    Begin
                      If FType = Yf then begin
                        Case Ch of
                          'Y','y' : S := 'Yes';
                          'N','n' : S := 'No ';
                        End;
                        P:=0;
                        GotoXY(X+P,Y);
                        Write(S,ConstStr(UnderScore,L-Length(S)));
                        Ch := #13;
                      End Else begin
                        If Length(S)=L then Delete(S,L,1);
                        P := P+1;
                        Insert(Ch,S,P);
                        Write(Copy(S,P,L));
                      End;
                    End
                    Else Beep;
               ^H : If P>0 then
                    Begin
                      Delete(S,P,1);
                      Write(^H,Copy(S,P,L),UnderScore);
                      P := P-1;
                    End
                    Else Beep;
              #27 : If KeyPressed then Begin
                      Read(Kbd,Ch2);
                      Case Ch2 of
                      #27 : Ch := #27;

                      { Func. Codes: F1=59 F2=60 F3=61 ... F10=68 }

                      #59 : Ch := ^Q;
                      #62 : Begin
                              P:=0;
                              S:='';
                              GotoXY(X+P,Y);
                              Write(S,ConstStr(UnderScore,L-Length(S)));
                            End;
                      #68 : Ch := ^Z;

                      { Keypad Codes:  71 72 73
                                       75 76 77
                                       79 80 81
                                    -82- -83-    }

                      #75 : If P>0 then P := P-1
                            Else Beep;
                      #77 : If P<Length(S) then P := P+1
                            Else Beep;
                      #79 : P := Length(S);
                      #71 : P := 0;
                      #72 : Ch := ^E;
                      #80 : Ch := ^X;
                      #83 : If P<Length(S) then
                            Begin
                              Delete(S,P+1,1);
                              Write(Copy(S,P+1,L),UnderScore);
                            End;
                      End; {case}
                    End Else Begin
                      S := EntryString;
                      P:=0;
                      GotoXY(X+P,Y);
                      Write(S,ConstStr(UnderScore,L-Length(S)));
                      Ch := #13;
                    End; {begin}
      End; {case}
      If (Ch in Term) and (FType = Df) then begin
        Error := False;
        Val(Copy(S,1,2),X3,X2);
        If X2<>0 then Error := True;
        Val(Copy(S,4,2),X1,X2);
        If X2=0 then
          Case X1 of
            4,6,9,11        : If NOT (X3 in [1..30]) then Error := True;
            1,3,5,7,8,10,12 : If NOT (X3 in [1..31]) then Error := True;
            2               : If NOT (X3 in [1..29]) then Error := True
           Else Error := True;
        End Else Error := True;
        Val(Copy(S,7,2),X1,X2);
        If X2<>0 then Error := True;
        If X2=0 then If X1<85 then Error := True;
        If Error then begin
          Beep;
          P:=0;
          S:=EntryString;
          GotoXY(X+P,Y);
          Write(S,ConstStr(UnderScore,L-Length(S)));
          Ch := #0;
          FirstChar := True;
        End;
      End;
    Until Ch in Term;
    P := Length(S);
    GotoXY(X+P,Y); Write('':L-P);
    TC := Ch;
  End; { procedure InputStr }

PROCEDURE InitializeFiles;
  VAR I:Integer;
      S:Str35;
  Begin
    OpenFile(DFile,DataFileName,SizeOf(DRec));
    If OK then OpenIndex(IFile,IndexFileName,15,1);
    If NOT OK then begin
      Beep;
      GotoXY(5,25);
      Write('Files not found.  Creating new files.');
      MakeFile(DFile,DataFileName,SizeOf(DRec));
      MakeIndex(IFile,IndexFileName,15,1);
    End;
    CloseFile(DFile);
    CloseIndex(IFile);
    If NOT Exist(ClassFileName) then begin
      Rewrite(CFile);
      S:='';
      For I:=1 to 30 do Write(CFile,S);
      Flush(CFile);
      Close(CFile);
    End Else begin
      Reset(CFile);
      For I:=1 to 30 do Read(CFile,ClassList[I]);
      Close(CFile);
    End;
    GotoXY(1,25);ClrEol;
  End; { procedure InitializeFiles }

PROCEDURE OpenFiles;
  VAR I:Integer;
  Begin
    OpenFile(DFile,DataFileName,SizeOf(DRec));
    OpenIndex(IFile,IndexFileName,15,1);
    Reset(CFile);
    For I:=1 to 30 do Read(CFile,ClassList[I]);
    Close(CFile);
  End; { procedure OpenFiles }

PROCEDURE CloseFiles;
  VAR I:Integer;
  Begin
    CloseFile(DFile);
    CloseIndex(IFile);
    Rewrite(CFile);
    For I:=1 to 30 do Write(CFile,ClassList[I]);
    Flush(CFile);
    Close(CFile);
  End; { procedure CloseFiles }

PROCEDURE RebuildKeys;
  VAR
    Fil : file;
    I,N : Integer;
  Begin
    DisplayID;
    If Exist(IndexFileName) then begin
      Assign(Fil,IndexFileName);
      Erase(Fil);
      MakeIndex(IFile,IndexFileName,15,1);
      CloseIndex(IFile);
      OpenFiles;
      For N := 1 to FileLen(DFile)-1 do begin
        GetRec(DFile,N,DRec);
        If DRec.Status=0 then begin
          GotoXY(10,17);
          Write('Reading: ',DRec.LName);ClrEol;
          Key:=DRec.LName;
          For I:=1 to Length(Key) do Key[I]:=Upcase(Key[I]);
          AddKey(IFile,N,Key);
        End;
      End;
      CloseFiles;
    End else begin
      GotoXY(10,17);
      Write(IndexFileName,' not found...');
      Beep;
      Delay(1000);
    End;
  End; { procedure RebuildKeys }

PROCEDURE ShowClass;
  VAR S,S2,S3:AnyStr;
      I:Integer;
  Begin
    S:='┌'+ConstStr('─',78)+'┐';             { #218,#196,#191 }
    FastWrite(0,3,HiAt,S);
    S:='│'+ConstStr(' ',78)+'│';             { #179 }
    For I:=1 to 15 do FastWrite(0,I+3,HiAt,S);
    S:='└'+ConstStr('─',78)+'┘';             { #192,#196,#217 }
    FastWrite(0,19,HiAt,S);
    For I:=1 to 15 do begin
      Str(I:2,S2);
      S3:=ClassList[I];
      If S3='' then S3:='<Not Assigned>';
      S:=S2+'-'+S3;
      If S3[1]='<' then FastWrite(3,I+3,LoAt,S) Else FastWrite(3,I+3,HiAt,S);
      Str(I+15:2,S2);
      S3:=ClassList[I+15];
      If S3='' then S3:='<Not Assigned>';
      S:=S2+'-'+S3;
      If S3[1]='<' then FastWrite(43,I+3,LoAt,S) Else FastWrite(43,I+3,HiAt,S);
    End;
  End; { procedure ShowClass }

PROCEDURE ShowScreen;
  Begin
    ClrScr;
    FastWrite(0, 0,HiAt,'LITLBOOK');
    FastWrite(9, 0,LoAt,'-- A User-Supported Address Book Program from Jamestown Software');
    FastWrite(0, 1,LoAt,'-------------------------------------------------------------------------------');
    FastWrite(0, 3,LoAt,'     First Name:');
    FastWrite(0, 5,LoAt,'      Last Name:');
    FastWrite(0, 7,LoAt,' Street Address:');
    FastWrite(0, 9,LoAt,'   City / State:');
    FastWrite(0,11,LoAt,'            Zip:');
    FastWrite(0,13,LoAt,'         Phone1:                        Phone2:');
    FastWrite(0,15,LoAt,'          Class:');
    FastWrite(0,17,LoAt,'-- Comment --------------------------------------------------------------------');
    FastWrite(0,21,LoAt,'-------------------------------------------------------------------------------');
  End; { procedure ShowScreen }

PROCEDURE SaveRecord;
  VAR I:Integer;
  Begin
    DRec.Status:=0;
    AddRec(DFile,RecNum,DRec);
    Key:=DRec.LName;
    For I:=1 to Length(Key) do Key[I]:=Upcase(Key[I]);
    If OK Then AddKey(IFile,RecNum,Key);
  End; { procedure SaveRecord }

PROCEDURE ReplaceRecord;
  VAR I:Integer;
  Begin
    Key:=DRec2.LName;
    For I:=1 to Length(Key) do Key[I]:=Upcase(Key[I]);
    DeleteKey(IFile,RecNum,Key);
    DRec.Status:=0;
    PutRec(DFile,RecNum,DRec);
    Key:=DRec.LName;
    For I:=1 to Length(Key) do Key[I]:=Upcase(Key[I]);
    AddKey(IFile,RecNum,Key);
  End; { procedure ReplaceRecord }

PROCEDURE ShowRecord;
  VAR S:AnyStr;
      I,J:Integer;
  Begin
    With DRec do begin
      S:=FName;
      S:=S+ConstStr(' ',15-Length(S));
      FastWrite(17, 3,HiAt,S);
      If MenuChoice='2' then begin
        GotoXY(60,4);
        ClrEol;
        Write('Rec.No.: ',RecNum);
      End;
      GotoXY(60,5);Write(UsedRecs(DFile),' records in use');
      S:=LName;
      S:=S+ConstStr(' ',30-Length(S));
      FastWrite(17, 5,HiAt,S);
      S:=Address;
      S:=S+ConstStr(' ',25-Length(S));
      FastWrite(17, 7,HiAt,S);
      S:=CityState;
      S:=S+ConstStr(' ',25-Length(S));
      FastWrite(17, 9,HiAt,S);
      S:=Zip;
      S:=S+ConstStr(' ',10-Length(S));
      FastWrite(17,11,HiAt,S);
      S:=Phone1;
      S:=S+ConstStr(' ',12-Length(S));
      FastWrite(17,13,HiAt,S);
      S:=Phone2;
      S:=S+ConstStr(' ',12-Length(S));
      FastWrite(49,13,HiAt,S);
      S:=Class;
      Val(Class,I,J);
      If (J<>0) or (I=0) or (S='') or
         ((J=0) and (I in [1..30])) and (ClassList[I]='')
         then S:=S+ConstStr(' ',2-Length(S))+'  <Not Assigned>'
      Else S:=S+ConstStr(' ',2-Length(S))+'  '+ClassList[I];
      S:=S+ConstStr(' ',40-Length(S));
      FastWrite(17,15,HiAt,S);
      S:=Comment;
      S:=S+ConstStr(' ',79-Length(S));
      FastWrite(0,19,HiAt,S);
    End;
  End; { procedure ShowRecord }

PROCEDURE Message(N:Integer;S:AnyStr);
  VAR I:Integer;
  Begin
    S:=S+ConstStr(' ',80-Length(S));
    If N>3 then begin
      For I:=22 to 24 do FastWrite(0, I,HiAt,ConstStr(' ',80));
      N:=N-3;
      If N>3 then N:=2;
    End;
    FastWrite(0, 21+N,HiAt,S);
  End; { procedure Message }

PROCEDURE EnterData;
  VAR S,S1 : AnyStr;
      I,J,N,
      Line : Integer;
      Done : Boolean;
      ExitSet : CharSet;
      TC      : Char;
  Begin
    NormVideo;
    Done:=False;
    Line:=1;
    RestoreCursor;
    If MenuChoice='1' then FillChar(DRec,SizeOf(DRec),0) Else DRec2:=DRec;
    If MenuChoice='1' then ShowRecord;
    With DRec do begin
      GotoXY(60,5);Write(UsedRecs(DFile),' records in use');
      Repeat
        ExitSet:=[#13,^E,^X,^Z];
        If MenuChoice='1' then Message(6,'Adding a new record to LITLBOOK... Pres <F10> when done.  <ESC>=Oops!')
          Else Message(6,'Editing a LITLBOOK record... Pres <F10> when done.  <ESC>=Oops!');
        RestoreCursor;
        Case Line of
          1 : Begin
                Message(1,'Enter the FIRST NAME (15 character limit).');
                S:=FName;
                InputStr(S,15,18,4,Af,ExitSet,TC);
                FName:=S;
              End;
          2 : Begin
                Message(1,'Enter the LAST NAME or COMPANY NAME (30 character limit).');
                S:=LName;
                InputStr(S,30,18,6,Af,ExitSet,TC);
                LName:=S;
              End;
          3 : Begin
                Message(1,'Enter the ADDRESS (25 character limit).');
                S:=Address;
                InputStr(S,25,18,8,Af,ExitSet,TC);
                Address:=S;
              End;
          4 : Begin
                Message(1,'Enter the CITY and STATE (25 character limit).');
                S:=CityState;
                InputStr(S,25,18,10,Af,ExitSet,TC);
                CityState:=S;
              End;
          5 : Begin
                Message(1,'Enter the ZIP CODE (10 character limit).');
                S:=Zip;
                InputStr(S,10,18,12,Nf,ExitSet,TC);
                Zip:=S;
              End;
          6 : Begin
                Message(1,'Enter PHONE NUMBER ONE (12 character limit).');
                S:=Phone1;
                InputStr(S,12,18,14,Nf,ExitSet,TC);
                Phone1:=S;
              End;
          7 : Begin
                Message(1,'Enter the PHONE NUMBER TWO (12 character limit).');
                S:=Phone2;
                InputStr(S,12,50,14,Nf,ExitSet,TC);
                Phone2:=S;
              End;
          8 : Repeat
                ExitSet:=[#13,^E,^X,^Z,^Q];
                Message(1,'Enter a CLASSIFICATION (Press <F1> for List).');
                S:=Class;
                GotoXY(18,16);
                ClrEol;
                InputStr(S,2,18,16,Nf,ExitSet,TC);
                Val(S,I,J);
                If (J<>0) or (S='') or (NOT (I in [1..30])) then S:='0';
                Class:=S;
                If (TC=^Q) or ((S<>'0') and (ClassList[I]='')) then begin
                  SaveScreen;
                  ShowClass;
                  If TC=^Q then begin
                    Repeat
                      ExitSet:=[#13];
                      Message(5,'Select CLASSIFICATION: ');
                      S1:='';
                      InputStr(S1,2,24,24,Nf,ExitSet,TC);
                      Val(S1,I,J);
                    Until (I in [1..30]) and (J=0);
                    If S1<>'' then Class:=S1;
                  End;
                  If ClassList[I]='' then begin
                    N:=I;
                    ExitSet:=[#13];
                    Str(N,S);
                    S:='Enter Classification Name for #'+S+': ';
                    Message(5,S);
                    S:='';
                    InputStr(S,35,36,24,Af,ExitSet,TC);
                    ClassList[N]:=S;
                  End;
                  RestoreScreen;
                End;
                If Class<>'0' then begin
                  GotoXY(18,16);
                  Write(Class);
                  GotoXY(22,16);
                  Val(Class,I,J);
                  Write(ClassList[I]);
                End;
              Until TC in [#13,^E,^X,^Z];
          9 : Begin
                Message(1,'Enter a COMMENT (79 character limit).   Press <Ctrl-D> for todays date.');
                ExitSet:=[#13,^E,^X,^Z,^D];
                Repeat
                  S:=Comment;
                  InputStr(S,79,1,20,Af,ExitSet,TC);
                  If TC=^D then S:=S+TDate+' ';
                  Comment:=S;
                Until TC in [#13,^E,^X,^Z];
              End;
        End;
        If TC in [#13,^X] then Line:=Line+1;
        If TC = ^E then Line:=Line-1;
        If (TC=^Z) or (Line=10) then begin
          HideCursor;
          Message(5,'Do you wish to continue working with this record?  Y/N');
          Beep;
          If NOT YES then begin
            Done:=True;
            Message(5,'Save this record?  Y/N');
            If YES then begin
              If MenuChoice='1' then SaveRecord else ReplaceRecord;
            End;
            If MenuChoice='1' then begin
              Message(5,'Another entry?  Y/N');
              If YES then EnterData;
            End;
          End;
        End;
        If Line<1 then Line:=9;
        If Line>9 then Line:=1;
      Until Done;
    End; { with }
    Message(5,'Closing files...');
  End; { procedure EnterData }

PROCEDURE BrowseEdit;
  VAR S    : AnyStr;
      I    : Integer;
      TC      : Char;

  PROCEDURE EnterSearch;
    Begin
      SaveScreen;
      If ParamRead then begin
        FastWrite(15,16,HiAt,'┌──────────────────────────────────────────────────┐');
        FastWrite(15,17,HiAt,'│                                                  │');
        FastWrite(15,18,HiAt,'│                                                  │');
        FastWrite(15,19,HiAt,'│                                                  │');
        FastWrite(15,20,HiAt,'└──────────────────────────────────────────────────┘');
        GotoXY(17,19);Write(' Search for: ');
        S:='';
        RestoreCursor;
        InputStr(S,15,30,19,Af,[#13],TC);
        HideCursor;
        Key:=S;
      End Else begin
        Key:=ParamStr(1);
        ParamRead:=True;
      End;
      For I:=1 to Length(Key) do Key[I]:=Upcase(Key[I]);
      SearchKey(IFile,RecNum,Key);
      If NOT OK then begin
        S:='No Record found...';
        S:=S+ConstStr(' ',79-Length(S));
        FastWrite(0,0,HiAt,S);
      End;
      GetRec(DFile,RecNum,DRec);
      RestoreScreen;
      ShowRecord;
    End; { procedure EnterSearch }

  Begin
    If UsedRecs(DFile)=0 then begin
      Beep;
      Message(5,' No active records... returning to menu');
      Delay(2000);
      Exit;
    End;
    Message(4,'Browsing records in LITLBOOK database...');
    Message(2,'Press  <Q> Quit  <P> Previous  <N> Next  <S> Search');
    Message(3,'       <E> Edit  <D> Delete');
    HideCursor;
    EnterSearch;
    Repeat
      Repeat
        Read(Kbd,Ch);
        Ch:=Upcase(Ch);
        If NOT (Ch in ['Q','P','N','S','E','D']) then Boop;
      Until Ch in ['Q','P','N','S','E','D'];
      FastWrite(0, 0,HiAt,'LITLBOOK  ');
      FastWrite(9, 0,LoAt,'-- A User-Supported Address Book Program from Jamestown Software');
      Case Ch of
        'Q' :;
        'P' : Begin
                PrevKey(IFile,RecNum,Key);
                If NOT OK then begin
                  S:='Last Record...';
                  S:=S+ConstStr(' ',79-Length(S));
                  FastWrite(0,0,HiAt,S);
                  PrevKey(IFile,RecNum,Key);
                End;
                GetRec(DFile,RecNum,DRec);
                ShowRecord;
              End;
        'N' : Begin
                NextKey(IFile,RecNum,Key);
                If NOT OK then begin
                  S:='First Record...';
                  S:=S+ConstStr(' ',79-Length(S));
                  FastWrite(0,0,HiAt,S);
                  NextKey(IFile,RecNum,Key);
                End;
                GetRec(DFile,RecNum,DRec);
                ShowRecord;
              End;
        'S' : Begin
                EnterSearch;
              End;
        'E' : Begin
                EnterData;
                HideCursor;
                Message(4,'Browsing records in LITLBOOK database...');
                Message(2,'Press  <Q> Quit  <P> Previous  <N> Next  <S> Search');
                Message(3,'       <E> Edit  <D> Delete');
                GetRec(DFile,RecNum,DRec);
                ShowRecord;
              End;
        'D' : Begin
                SaveScreen;
                FastWrite(25,16,HiAt,'┌───────────────────────────┐');
                FastWrite(25,17,HiAt,'│                           │');
                FastWrite(25,18,HiAt,'└───────────────────────────┘');
                TextColor(LightGray+Blink);
                GotoXY(29,18);
                Beep;
                Write('Delete... Are you SURE?');
                NormVideo;
                If YES then begin
                  RestoreScreen;
                  DeleteKey(IFile,RecNum,Key);
                  DeleteRec(DFile,RecNum);
                  SearchKey(IFile,RecNum,Key);
                  GetRec(DFile,RecNum,DRec);
                  ShowRecord;
                End Else RestoreScreen;
              End;
      End;
    Until Ch='Q';
    Message(5,'Closing files...');
  End; { procedure BrowseEdit }

PROCEDURE Inp;
  VAR N,I,J:Integer;
      S:AnyStr;
      TC:Char;
      YesToo:Boolean;
      Done:Boolean;
  Begin
    DisplayID;
    HideCursor;
    ClassSort:=False;
    ZipSort:=False;
    FastWrite(0,16,HiAt,CenterStr('Sort Method:  <A>lphabetically   or by <C>lassification',79));
    Repeat
      Read(Kbd,Ch);
      Ch:=Upcase(Ch);
      If NOT (Ch in ['A','C']) then Boop;
    Until Ch in ['A','C'];
    If ReportChoice='4' then begin
      FastWrite(0,16,HiAt,CenterStr('Print labels in Zip Code order?  Y/N',79));
      If YES then ZipSort:=True;
    End;
    FastWrite(0,16,HiAt,CenterStr(' ',79));
    If Ch='C' then begin
      ClassSort:=True;
      FastWrite(0,16,HiAt,CenterStr('Print all classifications?  Y/N',79));
      If YES then begin
        FastWrite(0,16,HiAt,CenterStr(' ',79));
        For N:=1 to FileLen(DFile)-1 do begin
          GetRec(DFile,N,DRec);
          If DRec.Status=0 then begin
            GotoXY(10,17);
            Write('Reading: ',DRec.LName);ClrEol;
            SortRelease(DRec);
          End;
        End;
      End Else begin
        GotoXY(1,17);ClrEol;
        SaveScreen;
        ClrScr;
        Repeat
          ShowClass;
          GotoXY(30,23);Write('Classification: ');
          S:='';
          RestoreCursor;
          InputStr(S,2,46,23,Nf,[#13],TC);
          HideCursor;
          Val(S,I,J);
        Until (I in [1..30]) and (J=0);
        RestoreScreen;
        For N:=1 to FileLen(DFile)-1 do begin
          GetRec(DFile,N,DRec);
          If DRec.Status=0 then begin
            GotoXY(10,17);
            Write('Reading: ',DRec.LName);ClrEol;
          End;
          If (DRec.Status=0) and (DRec.Class=S) then SortRelease(DRec);
        End;
      End;
    End Else For N:=1 to FileLen(DFile)-1 do begin
      GetRec(DFile,N,DRec);
      If DRec.Status=0 then begin
        GotoXY(10,17);
        Write('Reading: ',DRec.LName);ClrEol;
        SortRelease(DRec);
      End;
    End;
    LastNameFirst:=False;
    If ReportChoice='5' then begin
      FastWrite(0,16,HiAt,CenterStr('Print Last Name FIRST?   Y/N',79));
      If YES then LastNameFirst:=True;
    End;
    FastWrite(0,16,HiAt,CenterStr('Print to:   <S>creen  <P>rinter  <D>isk',79));
    Repeat
      Read(Kbd,Ch);
      Ch:=Upcase(Ch);
      If NOT (Ch in ['S','P','D']) then Boop;
    Until Ch in ['S','P','D'];
    Case Ch of
      'S' : Begin
              HardCopy:=False;
            End;
      'P' : Begin
              FastWrite(0,16,HiAt,CenterStr(' ',79));
              HardCopy:=True;
              If NOT PrReady then PrinterWarning;
              If Abort then HardCopy:=False;
              If HardCopy then PrinterSet;
              If Abort then HardCopy:=False;
            End;
      'D' : Begin
              Repeat
                FastWrite(0,16,HiAt,CenterStr(' ',79));
                Done:=False;
                S:='';
                GotoXY(10,17);
                Write('File Name:');
                RestoreCursor;
                InputStr(S,40,21,17,Af,[#13],TC);
                AsciiName:=S;
                HideCursor;
                AsciiFile:=False;
                HardCopy:=False;
                If S<>'' then begin
                  If Exist(S) then begin
                    FastWrite(0,16,HiAt,CenterStr('File Exists... Overwrite?  Y/N',79));
                    If YES then AsciiFile:=True;
                  End else AsciiFile:=True;
                End;
              Until (S='') or (AsciiFile=True);
              If S='' then Ch:='S';
            End;
    End;
    If NOT AsciiFile then begin
      If HardCopy then Assign(OutFile,'LST:') else Assign(OutFile,'CON:');
    End;
    If NOT Hardcopy then ClrScr;
  End; { procedure Inp }

FUNCTION Less;
  VAR First  : DataRecord Absolute X;
      Second : DataRecord Absolute Y;
      I,J,K  : Integer;
  Begin
    Val(First.Class,I,K);
    If (K<>0) or (I<0) then I:=0;
    Val(Second.Class,J,K);
    If (K<>0) or (J<0) then J:=0;
    If ZipSort and ClassSort then begin
      Less:=(I<J) or
            ((I=J) and (First.Zip<Second.Zip)) or
            ((I=J) and (First.Zip=Second.Zip) and (First.LName<Second.LName));
    End Else If ZipSort then begin
      Less:=(First.Zip<Second.Zip) or
            ((First.Zip=Second.Zip) and (First.LName<Second.LName));
    End Else If ClassSort then begin
      Less:=(I<J) or
            ((I=J) and (First.LName<Second.LName));
    End Else Less:=First.LName<Second.LName;
  End; { function Less }

PROCEDURE OutP;
  VAR S,S1,S2:AnyStr;
      I,J,Lines,Page:Integer;
      Test:String[2];
      TestInt,ClassInt,K:Integer;
      Ch:Char;

  FUNCTION Continue: Boolean;
    Begin
      SaveScreen;
      FastWrite(31,16,HiAt,'┌───────────────┐');
      FastWrite(31,17,HiAt,'│               │');
      FastWrite(31,18,HiAt,'└───────────────┘');
      Read(Kbd,Ch);
      Boop;
      TextColor(LightGray+Blink);
      GotoXY(34,18);
      Write('Continue? Y/N');
      NormVideo;
      If YES then Continue:=True else Continue:=False;
      RestoreScreen;
    End; { function Continue }

    FUNCTION ClearComma(S:AnyStr): AnyStr;
      VAR P:Integer;
      Begin
        While Pos(',',S)>0 Delete(S,Pos(',',S),1);
        ClearComma:=S;
      End; { function ClearComma }

  Begin
    If Abort then Exit;
    Lines:=0;
    Test:='99';
    Page:=1;
    If SortEOS then begin
      Beep;
      FastWrite(0,16,HiAt,CenterStr('No records meeting sort criteria...',79));
      Delay(1000);
      Exit;
    End;
    If AsciiFile then begin
      Assign(OutFile,AsciiName);
      {$I-}
      ReWrite(OutFile);
      {$I+}
      If IOResult<>0 then begin
        Close(OutFile);
        Boop;
        FastWrite(0,16,HiAt,CenterStr('File can not be opened...',79));
        Delay(1000);
        Exit;
      End;
      FastWrite(0,16,HiAt,CenterStr('File Format:  <P>rinter          <C>omma Delimited',79));
      FastWrite(0,17,HiAt,CenterStr('              <S>eparate Lines   <F>ixed Length   ',79));
      Repeat
        Read(Kbd,Ch);
        Ch:=Upcase(Ch);
        If NOT (Ch in ['P','F','C','S']) then Boop;
      Until Ch in ['P','F','C','S'];
      ClrScr;
      If Ch='C' then begin
        While NOT SortEOS do begin
          SortReturn(DRec);
          GotoXY(10,17);
          Write('Printing: ',DRec.LName);ClrEol;
          Write(OutFile,ClearComma(DRec.FName),',');
          Write(OutFile,ClearComma(DRec.LName),',');
          Write(OutFile,ClearComma(DRec.Address),',');
          Write(OutFile,ClearComma(DRec.CityState),',');
          Write(OutFile,ClearComma(DRec.Zip),',');
          Write(OutFile,ClearComma(DRec.Phone1),',');
          Write(OutFile,ClearComma(DRec.Phone2),',');
          Val(DRec.Class,I,J);
          If (J<>0) or (I=0) or
             ((J=0) and (I in [1..30])) and (ClassList[I]='')
             then S:='<Not Assigned>'
          Else S:=ClassList[I];
          Write(OutFile,ClearComma(S),',');
          WriteLn(OutFile,ClearComma(DRec.Comment));
        End;
        Flush(OutFile);
        Close(OutFile);
        Exit;
      End;
      If Ch='F' then begin
        While NOT SortEOS do begin
          SortReturn(DRec);
          GotoXY(10,17);
          Write('Printing: ',DRec.LName);ClrEol;
          Write(OutFile,DRec.FName,ConstStr(' ',15-Length(DRec.FName)));
          Write(OutFile,DRec.LName,ConstStr(' ',30-Length(DRec.LName)));
          Write(OutFile,DRec.Address,ConstStr(' ',25-Length(DRec.Address)));
          Write(OutFile,DRec.CityState,ConstStr(' ',25-Length(DRec.CityState)));
          Write(OutFile,DRec.Zip,ConstStr(' ',10-Length(DRec.Zip)));
          Write(OutFile,DRec.Phone1,ConstStr(' ',12-Length(DRec.Phone1)));
          Write(OutFile,DRec.Phone2,ConstStr(' ',12-Length(DRec.Phone2)));
          Val(DRec.Class,I,J);
          If (J<>0) or (I=0) or
             ((J=0) and (I in [1..30])) and (ClassList[I]='')
             then S:='<Not Assigned>'
          Else S:=ClassList[I];
          Write(OutFile,S,ConstStr(' ',35-Length(S)));
          WriteLn(OutFile,DRec.Comment,ConstStr(' ',79-Length(DRec.Comment)));
        End;
        Flush(OutFile);
        Close(OutFile);
        Exit;
      End;
      If Ch='S' then begin
        While NOT SortEOS do begin
          SortReturn(DRec);
          GotoXY(10,17);
          Write('Printing: ',DRec.LName);ClrEol;
          WriteLn(OutFile,DRec.FName);
          WriteLn(OutFile,DRec.LName);
          WriteLn(OutFile,DRec.Address);
          WriteLn(OutFile,DRec.CityState);
          WriteLn(OutFile,DRec.Zip);
          WriteLn(OutFile,DRec.Phone1);
          WriteLn(OutFile,DRec.Phone2);
          Val(DRec.Class,I,J);
          If (J<>0) or (I<=0) or
             ((J=0) and (I in [1..30])) and (ClassList[I]='')
             then S:='<Not Assigned>'
          Else S:=ClassList[I];
          WriteLn(OutFile,S);
          WriteLn(OutFile,DRec.Comment);
        End;
        Flush(OutFile);
        Close(OutFile);
        Exit;
      End;
    End;
    While NOT SortEOS do begin
      SortReturn(DRec);
      If HardCopy or AsciiFile then begin
        GotoXY(10,17);
        Write('Printing: ',DRec.LName);ClrEol;
      End;
      If ReportChoice='4' then begin
        WriteLn(OutFile ,ConstStr(' ',30),DRec.Class);
        If DRec.FName<>'' then S:=DRec.FName+' '+DRec.LName else S:=DRec.LName;
        WriteLn(OutFile,Copy(S,1,32));
        WriteLn(OutFile,DRec.Address);
        S:=DRec.CityState+' '+DRec.Zip;
        WriteLn(OutFile,S);
        WriteLn(OutFile);
        WriteLn(OutFile);
        If Keypressed then if NOT Continue then Exit;
      End Else Begin
        Val(Test,TestInt,K);
        If (K<>0) or (TestInt<0) then TestInt:=0;
        Val(DRec.Class,ClassInt,K);
        If (K<>0) or (ClassInt<0) then ClassInt:=0;
        If ( ((TestInt<>ClassInt) and ClassSort) or (Lines=0) ) and (HardCopy or AsciiFile) then begin
          If ClassSort then begin
            If Lines<>0 then WriteLn(OutFile);
            Val(DRec.Class,I,J);
            If (J<>0) or (I=0) or (ClassList[I]='') or
               ((J=0) and (I in [1..30])) and (ClassList[I]='')
               then S:='<Not Assigned>'
            Else S:=ClassList[I];
            S:=S+' ('+DRec.Class+')';
            Write(OutFile,S);
            I:=Length(S);
          End else begin
            Write(OutFile,'Alpha listing of ALL records');
            I:=28;
          End;
          If (Lines=0) and (Test<>'99') and
             (((TestInt=ClassInt) and ClassSort) or (NOT ClassSort))
          then begin
            Write(OutFile,' (cont.)');
            I:=I+8;
          End;
          Write(OutFile,'... LITLBOOK as of ',TDate);
          I:=I+27;
          If (I<71) and (Lines=0) then WriteLn(OutFile,ConstStr(' ',71-I),'Page',Page:3)
            else WriteLn(OutFile);
          WriteLn(OutFile,ConstStr('-',78));
          WriteLn(OutFile);
          If (Lines<>0) or (Test='99') or
             ((Lines=0) and (TestInt<>ClassInt)) then Test:=DRec.Class;
          If Lines=0 then begin
            Lines:=3;
            Page:=Page+1;
          End else Lines:=Lines+4;
        End;
        If LastNameFirst then begin
          For I:=1 to Length(DRec.LName) do DRec.LName[I]:=Upcase(DRec.LName[I]);
          If DRec.FName='' then S:=DRec.LName else S:=DRec.LName+', '+DRec.FName;
        End else begin
          If DRec.FName<>'' then S:=DRec.FName+' '+DRec.LName else S:=DRec.LName;
        End;
        S:=S+ConstStr('.',78-(Length(S)+Length(DRec.Phone1)))+' '+DRec.Phone1;
        WriteLn(OutFile,S);
        S:='    ';
        If DRec.Address<>'' then S:=S+DRec.Address+', ';
        S:=S+DRec.CityState+'  '+DRec.Zip;
        If DRec.Phone2<>'' then
          S:=S+ConstStr(' ',78-(Length(S)+Length(DRec.Phone2)))+' '+DRec.Phone2;
        If S<>'    ' then begin
          WriteLn(OutFile,S);
          Lines:=Lines+1;
        End;
        Lines:=Lines+1;
        If DRec.Comment<>'' then begin
          S:=DRec.Comment;
          S1:=Copy(S,1,70);
          I:=Length(S1);
          If I=70 then While (S1[I]<>' ') and (I<>0) do I:=I-1;
          S2:=Copy(S1,1,I);
          Delete(S,1,I);
          If S2<>''then begin
            WriteLn(OutFile,'    ',S2);
            Lines:=Lines+1;
          End;
          If S<>''then begin
            WriteLn(OutFile,'    ',S);
            Lines:=Lines+1;
          End;
        End;
        If NOT ClassSort then begin
          Val(DRec.Class,I,J);
          If (J<>0) or (I=0) or
             ((J=0) and (I in [1..30])) and (ClassList[I]='')
             then S:='<Not Assigned>' Else S:=ClassList[I];
          S:='('+S+')';
          WriteLn(OutFile,'        ',S);
          Lines:=Lines+1;
        End;
        If Lines>=54 then begin
          If HardCopy then Write(OutFile,#12);
          If AsciiFile then Write(OutFile,#13,#10,#13,#10,#13,#10);
          Lines:=0;
        End;
        If Keypressed then if NOT Continue then begin
          If AsciiFile then Close(OutFile);
          Exit;
        End;
      End;
    End;
    If (Lines<>0) and HardCopy then Write(OutFile,#12);
    Close(OutFile);
    If NOT (HardCopy or AsciiFile) then begin
      WriteLn;
      Write('Press any key to continue...');
      Beep;
      Read(Kbd,Ch);
    End;
    If AsciiFile then Close(OutFile);
  End; { procedure OutP }

PROCEDURE ChangeClass;
  VAR S   : AnyStr;
      I,J : Integer;
      TC  : Char;
      Done    : Boolean;
      ExitSet : CharSet;
  Begin
    SaveScreen;
    RestoreCursor;
    ClrScr;
    Done:=False;
    Repeat
      ShowClass;
      Repeat
        ExitSet:=[#13];
        Message(5,'Select CLASSIFICATION:       (0 to quit) ');
        S:='';
        InputStr(S,2,24,24,Nf,ExitSet,TC);
        Val(S,I,J);
        If S='0' then Done:=True;
      Until ((I in [1..30]) and (J=0) and (S<>'')) or Done;
      If NOT Done then begin
        Str(I,S);
        S:='Enter Classification Name for #'+S+': ';
        Message(5,S);
        S:=ClassList[I];
        InputStr(S,35,36,24,Af,ExitSet,TC);
        ClassList[I]:=S;
      End;
    Until Done;
    HideCursor;
    RestoreScreen;
  End; { procedure ChangeClass }

PROCEDURE ReportMenu;
  CONST N=24;
  VAR I:Integer;
      S:AnyStr;
  Begin
    ClrScr;
    DisplayID;
    Beep;
    FastWrite(N,09,HiAt,'4 -- PRINT labels');
    FastWrite(N,11,HiAt,'5 -- PRINT general listing');
    FastWrite(N,13,HiAt,'6 -- PRINT classification summary');
    FastWrite(N,15,HiAt,'7 -- CHANGE classification name');
    FastWrite(N,17,HiAt,'8 -- Rebuild keys');
    FastWrite(N,19,LoAt,'0 -- Return to Main Menu');
    FastWrite(N,22,LoAt,'Press your selection number...');
    HideCursor;
    Repeat
      Read(Kbd,ReportChoice);
      ReportChoice:=Upcase(ReportChoice);
      If NOT (ReportChoice in ['4'..'8','0']) then boop;
    Until ReportChoice in ['4'..'8','0'];
    Abort:=False;
    AsciiFile:=False;
    Case ReportChoice of
      '4' : Begin
              OpenFiles;
              I:=TurboSort(SizeOf(DRec));
              CloseFiles;
            End;
      '5' : Begin
              OpenFiles;
              I:=TurboSort(SizeOf(DRec));
              CloseFiles;
            End;
      '6' : Begin
              If NOT PrReady then PrinterWarning;
              If Abort then Exit;
              PrinterSet;
              If Abort then Exit;
              OpenFiles;
              WriteLn(Lst,'Classifications in LITLBOOK as of ',TDate);
              WriteLn(Lst,ConstStr('-',79));
              WriteLn(Lst,' ');
              For I:=1 to 30 do begin
                GotoXY(1,25);
                Write(I:2,' - ',ClassList[I]);ClrEol;
                WriteLn(Lst,I:2,' - ',ClassList[I]);
              End;
              WriteLn(Lst,#12);
              CloseFiles;
            End;
      '7' : Begin
              OpenFiles;
              ChangeClass;
              CloseFiles;
            End;
      '8' : Begin
              RebuildKeys;
            End;
    End; { case }
  End; { procedure ReportMenu }

PROCEDURE Menu;
  CONST N=20;
  Begin
    ClrScr;
    DisplayID;
    FastWrite(N,10,HiAt,'1 -- ADD new information');
    FastWrite(N,12,HiAt,'2 -- BROWSE/EDIT record information');
    FastWrite(N,14,HiAt,'3 -- PRINT record information / UTILITIES');
    FastWrite(N,17,LoAt,'0 -- QUIT and return to DOS');
    FastWrite(N,21,LoAt,'Press your selection number...');
    LowVideo;
    GotoXY(1,25);ClrEol;
    Write(FreeSpace:10:0,' left on ',EDrive);
    NormVideo;
    Repeat
      HideCursor;
      Repeat
        Read(Kbd,MenuChoice);
        MenuChoice:=Upcase(MenuChoice);
        If NOT (MenuChoice in ['1'..'3','0']) then boop;
      Until MenuChoice in ['1'..'3','0'];
      AsciiFile:=False;
      Case MenuChoice of
        '1' : Begin
                ShowScreen;
                OpenFiles;
                EnterData;
                CloseFiles;
                Menu;
              End;
        '2' : Begin
                ShowScreen;
                OpenFiles;
                BrowseEdit;
                CloseFiles;
                Menu;
              End;
        '3' : Begin
                ReportMenu;
                Menu;
              End;
      End; { case }
    Until MenuChoice='0';
  End; { procedure Menu }

Begin  { main }
  If MonitorType=7 then TextMode(2) else TextMode(3);
  TDate:=DOSDate;
  GetDir(0,EDrive);
  SetAt;
  InitIndex;
  Assign(CFile,ClassFileName);
  InitializeFiles;
  RunCount:=5;
  ParamRead:=False;
  If ParamCount>0 then begin
    ShowScreen;
    OpenFiles;
    BrowseEdit;
    CloseFiles;
    ParamRead:=True;
    Menu;
  End Else Menu;
  ClrScr;
  RestoreCursor;
End.